VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsReedSolomon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const m_nMaxSize As Long = 1024

Private m_objField As clsFiniteField

Private m_nDataCount As Long
Private m_nChecksumCount As Long
Private m_nPrimitiveRoot As Long
Private m_nStartingPower As Long

Private m_nGeneratorPolynomial(m_nMaxSize - 1) As Long

Friend Property Get Field() As clsFiniteField
Set Field = m_objField
End Property

Friend Property Set Field(ByVal obj As clsFiniteField)
Set m_objField = obj
End Property

Friend Property Get PrimitiveRoot() As Long
PrimitiveRoot = m_nPrimitiveRoot
End Property

Friend Property Let PrimitiveRoot(ByVal n As Long)
m_nPrimitiveRoot = n
End Property

Friend Property Get DataCount() As Long
DataCount = m_nDataCount
End Property

Friend Property Get ChecksumCount() As Long
ChecksumCount = m_nChecksumCount
End Property

Friend Property Get StartingPower() As Long
StartingPower = m_nStartingPower
End Property

Friend Property Get GeneratorPolynomialCoefficient(ByVal nDegree As Long) As Long
GeneratorPolynomialCoefficient = m_nGeneratorPolynomial(nDegree)
End Property

Friend Function Init(ByVal nDataCount As Long, ByVal nChecksumCount As Long, Optional ByVal objField As clsFiniteField, Optional ByVal nPrimitiveRoot As Long, Optional ByVal nStartingPower As Long) As Boolean
Dim i As Long, j As Long
Dim t As Long
'///
If nDataCount <= 0 Or nChecksumCount <= 0 Or nDataCount + nChecksumCount > m_nMaxSize Then Exit Function
If nStartingPower < 0 Then Exit Function
If objField Is Nothing Then Set objField = m_objField _
Else Set m_objField = objField
If objField Is Nothing Then Exit Function
'///
If nPrimitiveRoot = 0 Then nPrimitiveRoot = m_nPrimitiveRoot
If nPrimitiveRoot = 0 Then nPrimitiveRoot = m_objField.PrimitiveRoot
If nPrimitiveRoot = 0 Then Exit Function
m_nDataCount = nDataCount
m_nChecksumCount = nChecksumCount
m_nPrimitiveRoot = nPrimitiveRoot
m_nStartingPower = nStartingPower
'///some stupid things
t = objField.DiscreteExp(nStartingPower * objField.DiscreteLog(nPrimitiveRoot))
t = objField.Negative(t)
'///
'calc generator polynomial $g(x)=\prod_{i=1}^{nChecksumCount}(x-nPrimitiveRoot^i)$
'using naive polynomial multiply
Erase m_nGeneratorPolynomial
m_nGeneratorPolynomial(0) = t
m_nGeneratorPolynomial(1) = 1
For i = 2 To nChecksumCount
 t = objField.MultiplyLUT(t, nPrimitiveRoot)
 m_nGeneratorPolynomial(i) = 1
 For j = i - 1 To 1 Step -1
  m_nGeneratorPolynomial(j) = objField.Add(m_nGeneratorPolynomial(j - 1), _
  objField.MultiplyLUT(m_nGeneratorPolynomial(j), t))
 Next j
 m_nGeneratorPolynomial(0) = objField.MultiplyLUT(m_nGeneratorPolynomial(0), t)
Next i
'///over
Init = True
End Function

'input: index nChecksumCount to nChecksumCount+nDataCount-1
'output: index 0 to nChecksumCount-1
Friend Sub Encode(ByRef nData() As Long)
Dim t(m_nMaxSize - 1) As Long
Dim i As Long, j As Long, k As Long
'///input data
CopyMemory t(m_nChecksumCount), nData(m_nChecksumCount), m_nDataCount * 4&
'///calc the remainder using naive algorithm
For i = m_nDataCount - 1 To 0 Step -1
 k = t(i + m_nChecksumCount)
 If k <> 0 Then
  For j = 0 To m_nChecksumCount - 1
   t(i + j) = m_objField.Subtract(t(i + j), m_objField.MultiplyLUT(k, m_nGeneratorPolynomial(j)))
  Next j
 End If
Next i
'///output data
For i = 0 To m_nChecksumCount - 1
 nData(i) = m_objField.Negative(t(i))
Next i
'///over
End Sub

'nData [in, out]: input 0 to nChecksumCount+nDataCount-1,
'output is error-corrected result, if bCorrectChecksum then all error will be corrected,
'else only nChecksumCount to nChecksumCount+nDataCount-1 is corrected
'return value: error count, -1=fail to decode
Friend Function Decode(ByRef nData() As Long, Optional ByVal bCorrectChecksum As Boolean) As Long
'Berlekamp-Massey algorithm
Dim s(m_nMaxSize - 1) As Long
Dim c(m_nMaxSize - 1) As Long
Dim b(m_nMaxSize - 1) As Long
Dim i As Long, j As Long, k As Long
Dim l As Long, m As Long, n As Long
Dim o As Long, p As Long
Dim bb As Long, dd As Long, ll As Long
'///calculate syndromes
o = m_objField.DiscreteLog(m_nPrimitiveRoot)
n = m_objField.Order - 1
dd = (o * m_nStartingPower) Mod n
For i = 0 To m_nChecksumCount - 1
 bb = nData(0)
 m = dd
 For j = 1 To m_nChecksumCount + m_nDataCount - 1
  k = nData(j)
  If k <> 0 Then
   k = m_objField.DiscreteLog(k) + m
   If k >= n Then k = k - n
   bb = m_objField.Add(bb, m_objField.DiscreteExpUnsafe(k))
  End If
  m = m + dd
  If m >= n Then m = m - n
 Next j
 s(i) = bb
 dd = dd + o
 If dd >= n Then dd = dd - n
Next i
'///calculate error locator polynomial \Lambda(x) to c()
l = 0
m = 1
bb = 1
c(0) = 1
b(0) = 1
For n = 0 To m_nChecksumCount - 1
 '///calculate discrepancy
 'field K d = s_n + \Sigma_{i=1}^L c_i * s_{n-i};
 dd = s(n)
 For i = 1 To l
  dd = m_objField.Add(dd, m_objField.MultiplyLUT(c(i), s(n - i)))
 Next i
 If dd = 0 Then
  '///annihilation continues
  m = m + 1
 ElseIf l + l <= n Then
  '(B(x), C(x)) <-- (C(x), C(x) - d b^{-1} x^m B(x))
  Debug.Assert bb <> 0
  j = m_objField.DivideLUT(dd, bb)
  For i = n + 1 To 0 Step -1
   b(i) = c(i)
   If i >= m Then
    c(i) = m_objField.Subtract(c(i), m_objField.MultiplyLUT(j, b(i - m)))
   End If
  Next i
  '///
  l = n + 1 - l
  bb = dd
  m = 1
 Else
  'C(x) = C(x) - d b^{-1} x^m B(x);
  Debug.Assert bb <> 0
  j = m_objField.DivideLUT(dd, bb)
  For i = n + 1 To m Step -1
   c(i) = m_objField.Subtract(c(i), m_objField.MultiplyLUT(j, b(i - m)))
  Next i
  '///
  m = m + 1
 End If
Next n
'///
If l = 0 Then Exit Function
'///calculate formal derivative of error locator polynomial to b()
For i = 1 To l
 b(i - 1) = m_objField.ScalarMultiply(c(i), i)
Next i
'///calculate \Omega(x)=S(x)\Lambda(x) mod x^nChecksumCount to s()
For i = m_nChecksumCount - 1 To 0 Step -1
 bb = 0
 For j = 0 To i
  If j > l Then Exit For
  bb = m_objField.Add(bb, m_objField.MultiplyLUT(c(j), s(i - j)))
 Next j
 s(i) = bb
Next i
'///correct the error values using Forney algorithm
'does not work when m_nStartingPower<>1
n = m_objField.Order - 1
o = n - m_objField.DiscreteLog(m_nPrimitiveRoot)
'If bCorrectChecksum Then i = 0 Else i = m_nChecksumCount
'dd = (o * i) Mod n
'For i = i To m_nChecksumCount + m_nDataCount - 1
dd = 0
For i = 0 To m_nChecksumCount + m_nDataCount - 1
 bb = c(0)
 m = dd
 For j = 1 To l
  k = c(j)
  If k <> 0 Then
   k = m_objField.DiscreteLog(k) + m
   If k >= n Then k = k - n
   bb = m_objField.Add(bb, m_objField.DiscreteExpUnsafe(k))
  End If
  m = m + dd
  If m >= n Then m = m - n
 Next j
 '///
 If bb = 0 Then
  ll = ll + 1
  If bCorrectChecksum Or i >= m_nChecksumCount Then
   bb = b(0)
   p = s(0)
   m = dd
   For j = 1 To m_nChecksumCount - 1
    If j < l Then
     k = b(j)
     If k <> 0 Then
      k = m_objField.DiscreteLog(k) + m
      If k >= n Then k = k - n
      bb = m_objField.Add(bb, m_objField.DiscreteExpUnsafe(k))
     End If
    End If
    '///
    k = s(j)
    If k <> 0 Then
     k = m_objField.DiscreteLog(k) + m
     If k >= n Then k = k - n
     p = m_objField.Add(p, m_objField.DiscreteExpUnsafe(k))
    End If
    '///
    m = m + dd
    If m >= n Then m = m - n
   Next j
   '///
   If p = 0 Or bb = 0 Then
    'something goes wrong
    Debug.Assert False
    l = -1
    Exit For
   End If
   bb = (m_nStartingPower - 1) * dd + m_objField.DiscreteLog(p) - m_objField.DiscreteLog(bb)
   nData(i) = m_objField.Add(nData(i), m_objField.DiscreteExp(bb))
  End If
 End If
 '///
 dd = dd + o
 If dd >= n Then dd = dd - n
Next i
'///check if failed to decode
If l <> ll Then l = -1
'///
''debug
'If l < 0 Then
' Debug.Print "Failed to decode!!1"
'Else
' Debug.Print "Error count:"; l
' Debug.Print "Error locator polynomial:";
' For i = l To 0 Step -1
'  Debug.Print c(i);
' Next i
' Debug.Print
'End If
'///over
Decode = l
End Function
